
'----------------------------------------------------
' Hands-On 13-1
' No code in this Hands-On.
' Please follow the instructions in the book.
'----------------------------------------------------


'----------------------------------------------------
' Hands-On 13-2
'----------------------------------------------------

Sub FileInfo()
    Dim fs As Object
    Dim objFile As Object
    Dim strMsg As String

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objFile = fs.GetFile("C:\WINDOWS\System.ini")
    strMsg = "File name: " & _
        objFile.Name & vbCrLf
    strMsg = strMsg & "Disk: " & _
        objFile.Drive & vbCrLf
    strMsg = strMsg & "Date Created:" & _
        objFile.DateCreated & vbCrLf
    strMsg = strMsg & "Date Modified:" & _
        objFile.DateLastModified & vbCrLf
    MsgBox strMsg, , "File Information"
End Sub


'-----------------------------------------------------------
' Additional Examples between Hands-On 13-2 and Hands-On 13-3
'-----------------------------------------------------------

Sub FileExists()
    Dim fs As Object
    Dim strFile As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    strFile = InputBox("Enter the full name of the file: ")
    If fs.FileExists(strFile) Then
        MsgBox strFile & " was found."
    Else
        MsgBox "File does not exist."
    End If
End Sub


Sub CopyFile()
    Dim fs As Object
    Dim strFile As String
    Dim strNewFile As String

    strFile = "C:\Hello.doc"
    strNewFile = "C:\Program Files\Hello.doc"

    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CopyFile strFile, strNewFile
    MsgBox "A copy of the specified file was created."
    Set fs = Nothing
End Sub


Sub DeleteFile()
    ' This procedure requires that you set up
    ' a reference to Microsoft Scripting Runtime
    Dim fs As FileSystemObject
    Set fs = New FileSystemObject
 
    fs.DeleteFile "C:\Program Files\Hello.doc"
    MsgBox "The requested file was deleted."
End Sub


Function DriveExists(disk)
    Dim fs As Object
    Dim strMsg As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.DriveExists(disk) Then
        strMsg = "Drive " & UCase(disk) & " exists."
    Else
        strMsg = UCase(disk) & " was not found."
    End If
    DriveExists = strMsg
' run this function from the worksheet
' by entering the following in any cell : =DriveExists("E:\")
End Function


Sub DriveInfo()
    Dim fs, disk, infoStr, strDiskName
    strDiskName = InputBox("Enter the drive letter:", _
        "Drive Name", "C:\")

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set disk = fs.GetDrive(fs.GetDriveName(strDiskName))
    infoStr = "Drive: " & UCase(strDiskName) & vbCrLf
    infoStr = infoStr & "Drive letter: " & _
        UCase(disk.DriveLetter) & vbCrLf
    infoStr = infoStr & "Drive Type: " & disk.DriveType & vbCrLf
    infoStr = infoStr & "Drive File System: " & _
    disk.FileSystem & vbCrLf
    infoStr = infoStr & "Drive SerialNumber: " & _
        disk.SerialNumber & vbCrLf
    infoStr = infoStr & "Total Size in Bytes: " & _
        FormatNumber(disk.TotalSize / 1024, 0) & " Kb" & vbCrLf
    infoStr = infoStr & "Free Space on Drive: " & _
        FormatNumber(disk.FreeSpace / 1024, 0) & " Kb" & vbCrLf
    MsgBox infoStr, vbInformation, "Drive Information"
End Sub


Function DriveName(disk)
    Dim fs As Object
    Dim strDiskName As String

    Set fs = CreateObject("Scripting.FileSystemObject")
    strDiskName = fs.GetDriveName(disk)
    DriveName = strDiskName
' run this function from the Immediate window
' by entering ?DriveName("D:\")
End Function


Sub DoesFolderExist()
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    MsgBox fs.FolderExists("C:\Program Files")
End Sub


Sub FilesInFolder()
    Dim fs As Object
    Dim objFolder As Object
    Dim objFile As Object

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fs.GetFolder("C:\")

    Workbooks.Add
    For Each objFile In objFolder.Files
        ActiveCell.Formula = objFile.Name
        ActiveCell.Offset(0, 1).Range("A1").Select
        Selection.Formula = objFile.Type
        ActiveCell.Offset(1, -1).Range("A1").Select
    Next
    Columns("A:B").Select
    Selection.Columns.AutoFit
End Sub


Sub SpecialFolders()
    Dim fs As Object
    Dim strWindowsFolder As String
    Dim strSystemFolder As String
    Dim strTempFolder As String

    Set fs = CreateObject("Scripting.FileSystemObject")
    strWindowsFolder = fs.GetSpecialFolder(0)
    strSystemFolder = fs.GetSpecialFolder(1)
    strTempFolder = fs.GetSpecialFolder(2)

    MsgBox strWindowsFolder & vbCrLf _
        & strSystemFolder & vbCrLf _
        & strTempFolder, vbInformation + vbOKOnly, _
            "Special Folders"
End Sub


Sub MakeNewFolder()
    Dim fs, objFolder
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fs.CreateFolder("C:\TestFolder")
    MsgBox "A new folder named " & _
    objFolder.Name & " was created."
End Sub


Sub MakeFolderCopy()
    Dim fs As FileSystemObject
    Set fs = New FileSystemObject
    If fs.FolderExists("C:\TestFolder") Then
        fs.CopyFolder "C:\TestFolder", "C:\FinalFolder"
        MsgBox "The folder was copied."
    End If
End Sub


Sub RemoveFolder()
    Dim fs As FileSystemObject
    Set fs = New FileSystemObject

    If fs.FolderExists("C:\TestFolder") Then
        fs.DeleteFolder "C:\TestFolder"
        MsgBox "The folder was deleted."
    End If
End Sub


Sub ReadTextFile()
    Dim fs As Object
    Dim objFile As Object
    Dim strContent As String
    Dim strFileName As String

    strFileName = "C:\WINNT\System.ini"
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objFile = fs.OpenTextFile(strFileName)
    Do While Not objFile.AtEndOfStream
        strContent = strContent & objFile.ReadLine & vbCrLf
    Loop

    objFile.Close
    Set objFile = Nothing
    ActiveWorkbook.Sheets(3).Select
    Range("A1").Select
    Selection.Formula = strContent
End Sub


Sub DrivesList()
    Dim fs As Object
    Dim colDrives As Object
    Dim strDrive As String

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set colDrives = fs.Drives

        For Each Drive In colDrives
            strDrive = "Drive " & Drive.DriveLetter & ": "
            Debug.Print strDrive
        Next
End Sub


Sub CountFilesInFolder()
    Dim fs, strFolder, objFolder, colFiles

    strFolder = InputBox("Enter the folder name:")
    If Not IsFolderEmpty(strFolder) Then
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set objFolder = fs.GetFolder(strFolder)
        Set colFiles = objFolder.Files
        MsgBox "The number of files in the folder " & _
            strFolder & "=" & colFiles.Count
    End If
End Sub


Function IsFolderEmpty(myFolder)
    Dim fs, objFolder

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fs.GetFolder(myFolder)
    IsFolderEmpty = (objFolder.Size = 0)
End Function


Sub CDROM_DriveLetter()
    Const CDROM = 4
    Dim fs, colDrives
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set colDrives = fs.Drives
    For Each Drive In colDrives
        If Drive.DriveType = CDROM Then
            MsgBox "The CD-ROM Drive: " & Drive.DriveLetter
        End If
    Next
End Sub


Function IsCDROMReady(strDriveLetter)
    Dim fs, objDrive

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objDrive = fs.GetDrive(strDriveLetter)

    IsCDROMReady = (objDrive.DriveType = 4) And _
        objDrive.IsReady = True
    ' run this function from the Immediate window
    ' by entering: ?IsCDROMReady("D:")
End Function


Sub CreateFile_Method1()
    Dim fs, objFile
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objFile = fs.CreateTextFile("C:\Phones.txt", True)
    objFile.WriteLine ("Margaret Kubiak: 212-338-8778")
    objFile.WriteBlankLines (2)
    objFile.WriteLine ("Robert Prochot: 202-988-2331")
    objFile.Close
End Sub


Sub CreateFile_Method2()
    Dim fs, objFile
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objFile = fs.OpenTextFile("C:\Shopping.txt", _
            ForWriting, True)
    objFile.WriteLine ("Bread")
    objFile.WriteLine ("Milk")
    objFile.WriteLine ("Strawberries")
    objFile.Close
End Sub


Sub CreateFile_Method3()
    Dim fs, objFile, objText
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CreateTextFile "New.txt"
    Set objFile = fs.GetFile("New.txt")
    Set objText = objFile.OpenAsTextStream(ForWriting, _
        TristateUseDefault)
    objText.Write "Wedding Invitation"
    objText.Close
    Set objText = objFile.OpenAsTextStream(ForReading, _
        TristateUseDefault)
    MsgBox objText.ReadLine
    objText.Close
End Sub


'----------------------------------------------------
' Hands-On 13-3
'----------------------------------------------------

Sub RunNotepad()
    Dim WshShell As Object
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.Run "Notepad"
    Set WshShell = Nothing
End Sub


Sub OpenTxtFileInNotepad()
    Dim WshShell As Object
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.Run "Notepad C:\Phones.txt"
    Set WshShell = Nothing
End Sub


'----------------------------------------------------
' Hands-On 13-4
'----------------------------------------------------

Sub CreateShortcut()
    ' this script creates two desktop shortcuts
    Dim WshShell As Object
    Dim objShortcut As Object
    
    Set WshShell = CreateObject("WScript.Shell")
    ' create an Internet shortcut
    Set objShortcut = WshShell.CreateShortcut(WshShell. _
        SpecialFolders("Desktop") & "\Wordware.url")
    objShortcut.TargetPath = "http://www.wordware.com"
    
    objShortcut.Save
    
    ' create a file shortcut
    Set objShortcut = WshShell.CreateShortcut(WshShell. _
        SpecialFolders("Desktop") & "\" & ActiveWorkbook.Name & ".lnk")
    With objShortcut
        .TargetPath = ActiveWorkbook.FullName
        .WindowStyle = 7
        .Save
    End With

    Set objShortcut = Nothing
    Set WshShell = Nothing
End Sub





